Overlap matrix heatmap
Reproducing heatmap from issues/28#issuecomment-636012185
Library
Data
mat <- readRDS("input/overlap_matrix.rds")
mat$isProm <- (abs(mat$distanceToTSS) < 5000) / 2 + (abs(mat$distanceToTSS) < 2500) / 2
fields <- c(
"isProm", "diffAccessibility-logFC", "RNA_PND8_vs_PND15_logFC",
"RNA_PND15_vs_Adult_logFC", "BS_PND7_meth", "BS_PND14_meth", "BS_PNW8_meth",
grep("ChIP", colnames(mat), value = TRUE)
)
mat2 <- mat[, fields]
mat2 <- do.call(cbind, lapply(mat2, as.numeric))
se <- getBreaks(mat2, split.prop = 0.96, 100)
cols <- colorRampPalette(c("blue", "black", "yellow"))(101)
mat2 <- sortRows(mat2, z = FALSE)
prom <- mat2[mat2[, 1] > 0, ]
distal <- mat2[mat2[, 1] == 0, ]Subset data
Level 1
Level 2
Level 3
Level 4
# H3K4me3
mat$H3K4me3 <- mat$ChIP_PNW8_H3K4me3
# H3K27ac and not H3K27me or H3K4me3
mat$H3K27acOnly <- (mat$ChIP_PNW8_H3K27ac == TRUE) & (mat$ChIP_PNW8_H3K27me3 == FALSE) & (mat$ChIP_PNW8_H3K4me3 == FALSE)
# H3K27me and not H3K27ac or H3K4me3
mat$H3K27me3Only <- (mat$ChIP_PNW8_H3K27me3 == TRUE) & (mat$ChIP_PNW8_H3K27ac == FALSE) & (mat$ChIP_PNW8_H3K4me3 == FALSE)
rownames(mat) <- mat$NameSplit matrix
# select the columns according to which we want to split
mat2 <- mat[, 74:80]
# for distal sites, we don't want to look at RNA:
mat2$isProximalActive[mat2$isDistal] <- NA
mat2$expUp[mat2$isDistal] <- NA
splitAndName <- function(o) {
s <- split(o, apply(o, 1, collapse = " ", paste))
names(s) <- as.character(sapply(s, FUN = function(x) {
x <- x[1, , drop = FALSE]
y <- c(
ifelse(x$isDistal, "distal", "proximal"),
ifelse(x$isProximalActive, "active", "inactive"),
ifelse(x$accUp, "accUp", "accDown"),
ifelse(x$expUp, "rnaUp", "rnaDown")
)
if (!is.null(x$H3K4me3)) {
y <- c(
y,
ifelse(x$H3K4me3, "H3K4me3", NA),
ifelse(x$H3K27acOnly, "H3K27ac", NA),
ifelse(x$H3K27me3Only, "H3K27me3", NA)
)
}
paste(y[!is.na(y)], collapse = ".")
}))
s
}
# split without the histone marks
s1 <- splitAndName(mat2[, 1:4])
# sapply(s1, nrow)
# very fine-grained splitting, using all columns:
s2 <- splitAndName(mat2)
# sapply(s2, nrow)
s1_1 <- lapply(s1, function(x) data.frame(Name = rownames(x), x))
s2_1 <- lapply(s2, function(x) data.frame(Name = rownames(x), x))
df_s1 <- plyr::ldply(s1_1, data.frame)
colnames(df_s1)[1] <- "anno"
rownames(df_s1) <- df_s1$Name
sp_df_s1 <- split(x = df_s1, f = df_s1$anno)
df_s2 <- plyr::ldply(s2_1, data.frame)
colnames(df_s2)[1] <- "anno"
rownames(df_s2) <- df_s2$Name
sp_df_s2 <- split(x = df_s2, f = df_s2$anno)Heatmap
Regions without ChIP data
tab_s1 <- sortRows(df_s1[, -c(1:2)], z = FALSE)
col <- c(brewer.pal(n = 3, name = "Set1")[1:2], "grey")
lgd <- Legend(
labels = c("TRUE", "FALSE", "NA"), legend_gp = gpar(fill = col[c(2, 1, 3)]), title = "Status",
title_gp = gpar(col = "Blue", fontsize = 14)
)
draw(
Heatmap(
matrix = data.matrix(df_s1[, -c(1:2)]),
col = col,
cluster_rows = FALSE, cluster_columns = FALSE,
show_row_names = FALSE, row_order = rownames(tab_s1),
row_split = df_s1$anno, name = "Regions without ChIP data", show_heatmap_legend = FALSE
),
heatmap_legend_list = lgd
)Regions with ChIP data
tab_s2 <- sortRows(df_s2[, -c(1:2)], z = FALSE)
draw(
Heatmap(
matrix = data.matrix(df_s2[, -c(1:2)]),
col = col,
cluster_rows = FALSE, cluster_columns = FALSE,
show_row_names = FALSE, row_order = rownames(tab_s2),
row_split = df_s2$anno, name = "Regions with ChIP data", show_heatmap_legend = FALSE
),
heatmap_legend_list = lgd
)Individual heatmaps
make_DT <- function(df) {
df <- data.frame(df, stringsAsFactors = F, check.names = F)
DT::datatable(
df,
rownames = F,
filter = "top",
extensions = c("Buttons", "ColReorder"),
options = list(
searching = FALSE,
pageLength = 5,
scrollX = T,
buttons = c("copy", "csv", "excel", "pdf", "print"),
colReorder = list(realtime = FALSE),
dom = "fltBip",
width = "8px", height = "5px"
)
)
}Regions without ChIP data
get_col <- function(mat){
col <- c(brewer.pal(n = 3, name = "Set1")[1:2], "grey")
# col <- c("blue", "red", "grey")
v <- unique(as.vector(mat))
colors <- sapply(v, function(x){
c <- NULL
if(x %in% 1){
c <- c(true = col[2])
} else if(x %in% 0){
c <- c(false = col[1])
} else{
c <- c(na = col[3])
}
return(c)
})
return(colors)
}for (i in 1:length(sp_df_s1)) {
n <- names(sp_df_s1)[i]
cat("### ", n, "{.tabset .tabset-pills} \n\n\n")
cat("#### Heatmap \n\n\n")
m <- data.matrix(sp_df_s1[[i]][, -c(1:2)])
col <- sort(get_col(m))
lgd <- Legend(
labels = toupper(names(col)), legend_gp = gpar(fill = as.character(col)), title = "Status",
title_gp = gpar(col = "Blue", fontsize = 14)
)
try(
draw(
Heatmap(
matrix = m,
col = as.character(col)[c(2,1,3)], name = "Values",
cluster_rows = FALSE, cluster_columns = FALSE,
column_title = n,
show_row_names = FALSE,
show_heatmap_legend = FALSE
),
heatmap_legend_list = lgd
)
)
cat("\n\n\n")
system("mkdir -p ./output/plots/without_ChIP")
pdf(file = paste0("./output/plots/without_ChIP/", n, ".pdf"), width = 11, height = 8.5)
try(
draw(
Heatmap(
matrix = m,
col = as.character(col)[c(2,1,3)], name = "Values",
cluster_rows = FALSE, cluster_columns = FALSE,
column_title = n,
show_row_names = FALSE,
show_heatmap_legend = FALSE
),
heatmap_legend_list = lgd
)
)
dev.off()
cat("\n\n\n")
cat("#### Table \n\n\n")
tab <- inner_join(mat[, 1:73], sp_df_s1[[i]])
print(htmltools::tagList(make_DT(tab)))
cat("\n\n\n")
system("mkdir -p ./output/tables/without_ChIP")
writexl::write_xlsx(x = tab, path = paste0("./output/tables/without_ChIP/", n, ".xlsx"), col_names = T, format_headers = T)
}distal.accDown
Heatmap
Table
distal.accUp
Heatmap
Error : You should have at least two distinct break values.
Error : You should have at least two distinct break values.
Table
proximal.active.accDown.rnaDown
Heatmap
Table
proximal.active.accDown.rnaUp
Heatmap
Table
proximal.active.accUp.rnaDown
Heatmap
Table
proximal.active.accUp.rnaUp
Heatmap
Table
proximal.inactive.accDown
Heatmap
Error : You should have at least two distinct break values.
Error : You should have at least two distinct break values.
Table
proximal.inactive.accUp
Heatmap
Table
Regions with ChIP data
for (i in 1:length(sp_df_s2)) {
n <- names(sp_df_s2)[i]
cat("### ", n, "{.tabset .tabset-pills} \n\n\n")
cat("#### Heatmap \n\n\n")
m <- data.matrix(sp_df_s2[[i]][, -c(1:2)])
col <- get_col(m)
lgd <- Legend(
labels = toupper(names(col)), legend_gp = gpar(fill = as.character(col)), title = "Status",
title_gp = gpar(col = "Blue", fontsize = 14)
)
try(
draw(
Heatmap(
matrix = m,
col = as.character(col), name = "Values",
cluster_rows = FALSE, cluster_columns = FALSE,
column_title = n,
show_row_names = FALSE,
show_heatmap_legend = FALSE
),
heatmap_legend_list = lgd
)
)
cat("\n\n\n")
system("mkdir -p ./output/plots/with_ChIP")
pdf(file = paste0("./output/plots/with_ChIP/", n, ".pdf"), width = 11, height = 8.5)
try(
draw(
Heatmap(
matrix = m,
col = col, name = "Values",
cluster_rows = FALSE, cluster_columns = FALSE,
column_title = n,
show_row_names = FALSE,
show_heatmap_legend = FALSE
),
heatmap_legend_list = lgd
)
)
dev.off()
cat("\n\n\n")
cat("#### Table \n\n\n")
tab <- inner_join(mat[, 1:73], sp_df_s2[[i]])
print(htmltools::tagList(make_DT(tab)))
cat("\n\n\n")
system("mkdir -p ./output/tables/with_ChIP")
writexl::write_xlsx(x = tab, path = paste0("./output/tables/with_ChIP/", n, ".xlsx"), col_names = T, format_headers = T)
}distal.accDown
Heatmap
Error : Values: cannot map colors to some of the levels: 1, 0
Table
distal.accDown.H3K27ac
Heatmap
Error : Values: cannot map colors to some of the levels: 1, 0
Table
distal.accDown.H3K27me3
Heatmap
Error : Values: cannot map colors to some of the levels: 1, 0
Table
distal.accDown.H3K4me3
Heatmap
Error : Values: cannot map colors to some of the levels: 1, 0
Table
distal.accUp
Heatmap
Error : Values: cannot map colors to some of the levels: 1, 0
Table
distal.accUp.H3K27ac
Heatmap
Error : Values: cannot map colors to some of the levels: 1, 0
Table
distal.accUp.H3K27me3
Heatmap
Error : Values: cannot map colors to some of the levels: 1, 0
Table
distal.accUp.H3K4me3
Heatmap
Error : Values: cannot map colors to some of the levels: 1, 0
Table
proximal.active.accDown.rnaDown
Heatmap
Error : Values: cannot map colors to some of the levels: 0, 1
Table
proximal.active.accDown.rnaDown.H3K27ac
Heatmap
Error : Values: cannot map colors to some of the levels: 0, 1
Table
proximal.active.accDown.rnaDown.H3K27me3
Heatmap
Error : Values: cannot map colors to some of the levels: 0, 1
Table
proximal.active.accDown.rnaDown.H3K4me3
Heatmap
Error : Values: cannot map colors to some of the levels: 0, 1
Table
proximal.active.accDown.rnaUp
Heatmap
Error : Values: cannot map colors to some of the levels: 0, 1
Table
proximal.active.accDown.rnaUp.H3K27ac
Heatmap
Error : Values: cannot map colors to some of the levels: 0, 1
Table
proximal.active.accDown.rnaUp.H3K4me3
Heatmap
Error : Values: cannot map colors to some of the levels: 0, 1
Table
proximal.active.accUp.rnaDown
Heatmap
Error : Values: cannot map colors to some of the levels: 0, 1
Table
proximal.active.accUp.rnaDown.H3K27ac
Heatmap
Error : Values: cannot map colors to some of the levels: 0, 1
Table
proximal.active.accUp.rnaDown.H3K27me3
Heatmap
Error : Values: cannot map colors to some of the levels: 0, 1
Table
proximal.active.accUp.rnaDown.H3K4me3
Heatmap
Error : Values: cannot map colors to some of the levels: 0, 1
Table
proximal.active.accUp.rnaUp
Heatmap
Error : Values: cannot map colors to some of the levels: 0, 1
Table
proximal.active.accUp.rnaUp.H3K27ac
Heatmap
Error : Values: cannot map colors to some of the levels: 0, 1
Table
proximal.active.accUp.rnaUp.H3K27me3
Heatmap
Error : Values: cannot map colors to some of the levels: 0, 1
Table
proximal.active.accUp.rnaUp.H3K4me3
Heatmap
Error : Values: cannot map colors to some of the levels: 0, 1
Table
proximal.inactive.accDown
Heatmap
Error : Values: cannot map colors to some of the levels: 0
Table
proximal.inactive.accDown.H3K27ac
Heatmap
Error : Values: cannot map colors to some of the levels: 0, 1
Table
proximal.inactive.accDown.H3K27me3
Heatmap
Error : Values: cannot map colors to some of the levels: 0, 1
Table
proximal.inactive.accDown.H3K4me3
Heatmap
Error : Values: cannot map colors to some of the levels: 0, 1
Table
proximal.inactive.accUp
Heatmap
Error : Values: cannot map colors to some of the levels: 0, 1
Table
proximal.inactive.accUp.H3K27ac
Heatmap
Error : Values: cannot map colors to some of the levels: 0, 1
Table
proximal.inactive.accUp.H3K27me3
Heatmap
Error : Values: cannot map colors to some of the levels: 0, 1
Table
proximal.inactive.accUp.H3K4me3
Heatmap
Error : Values: cannot map colors to some of the levels: 0, 1
Table
SessionInfo
─ Session info ───────────────────────────────────────────────────────────────
setting value
version R version 3.6.2 (2019-12-12)
os Ubuntu 16.04.6 LTS
system x86_64, linux-gnu
ui X11
language (EN)
collate en_US.UTF-8
ctype en_US.UTF-8
tz Europe/Zurich
date 2020-06-12
─ Packages ───────────────────────────────────────────────────────────────────
package * version date lib
assertthat 0.2.1 2019-03-21 [1]
backports 1.1.7 2020-05-13 [1]
Biobase 2.46.0 2019-10-29 [1]
BiocGenerics 0.32.0 2019-10-29 [1]
BiocParallel 1.20.1 2019-12-21 [1]
bitops 1.0-6 2013-08-17 [1]
bookdown 0.18 2020-03-05 [1]
callr 3.4.3 2020-03-28 [1]
caTools 1.18.0 2020-01-17 [1]
circlize 0.4.9 2020-04-30 [1]
cli 2.0.2 2020-02-28 [1]
clue 0.3-57 2019-02-25 [1]
cluster 2.1.0 2019-06-19 [1]
codetools 0.2-16 2018-12-24 [1]
colorspace 1.4-1 2019-03-18 [1]
ComplexHeatmap * 2.2.0 2019-10-29 [1]
crayon 1.3.4 2017-09-16 [1]
crosstalk 1.1.0.1 2020-03-13 [1]
curl 4.3 2019-12-02 [1]
data.table 1.12.8 2019-12-09 [1]
DelayedArray 0.12.3 2020-04-09 [1]
dendextend 1.13.4 2020-02-28 [1]
desc 1.2.0 2018-05-01 [1]
devtools 2.3.0 2020-04-10 [1]
digest 0.6.25 2020-02-23 [1]
dplyr * 1.0.0 2020-05-29 [1]
DT * 0.13 2020-03-23 [1]
edgeR 3.28.1 2020-02-26 [1]
ellipsis 0.3.1 2020-05-15 [1]
evaluate 0.14 2019-05-28 [1]
fansi 0.4.1 2020-01-08 [1]
foreach 1.5.0 2020-03-30 [1]
fs 1.4.1 2020-04-04 [1]
gclus 1.3.2 2019-01-07 [1]
gdata 2.18.0 2017-06-06 [1]
generics 0.0.2 2018-11-29 [1]
GenomeInfoDb 1.22.1 2020-03-27 [1]
GenomeInfoDbData 1.2.2 2019-11-18 [1]
GenomicRanges 1.38.0 2019-10-29 [1]
GetoptLong 0.1.8 2020-01-08 [1]
ggplot2 3.3.1 2020-05-28 [1]
GlobalOptions 0.1.1 2019-09-30 [1]
glue 1.4.1 2020-05-13 [1]
gplots 3.0.3 2020-02-25 [1]
gridExtra 2.3 2017-09-09 [1]
gtable 0.3.0 2019-03-25 [1]
gtools 3.8.2 2020-03-31 [1]
htmltools 0.4.0 2019-10-04 [1]
htmlwidgets 1.5.1 2019-10-08 [1]
IRanges 2.20.2 2020-01-13 [1]
iterators 1.0.12 2019-07-26 [1]
jsonlite 1.6.1 2020-02-02 [1]
KernSmooth 2.23-16 2019-10-15 [1]
knitr 1.28 2020-02-06 [1]
lattice 0.20-41 2020-04-02 [1]
lifecycle 0.2.0 2020-03-06 [1]
limma 3.42.2 2020-02-03 [1]
locfit 1.5-9.4 2020-03-25 [1]
magrittr 1.5 2014-11-22 [1]
MASS 7.3-51.5 2019-12-20 [1]
Matrix 1.2-18 2019-11-27 [1]
matrixStats 0.56.0 2020-03-13 [1]
memoise 1.1.0.9000 2020-05-06 [1]
munsell 0.5.0 2018-06-12 [1]
openxlsx 4.1.4 2019-12-06 [1]
pheatmap * 1.0.12 2019-01-04 [1]
pillar 1.4.4 2020-05-05 [1]
pkgbuild 1.0.8 2020-05-07 [1]
pkgconfig 2.0.3 2019-09-22 [1]
pkgload 1.1.0 2020-05-29 [1]
png 0.1-7 2013-12-03 [1]
prettyunits 1.1.1 2020-01-24 [1]
processx 3.4.2 2020-02-09 [1]
ps 1.3.3 2020-05-08 [1]
purrr 0.3.4 2020-04-17 [1]
R6 2.4.1 2019-11-12 [1]
randomcoloR 1.1.0.1 2019-11-24 [1]
RColorBrewer * 1.1-2 2014-12-07 [1]
Rcpp 1.0.4.6 2020-04-09 [1]
RCurl 1.98-1.2 2020-04-18 [1]
registry 0.5-1 2019-03-05 [1]
remotes 2.1.1 2020-02-15 [1]
rjson 0.2.20 2018-06-08 [1]
rlang 0.4.6 2020-05-02 [1]
rmarkdown 2.1 2020-01-20 [1]
rmdformats 0.4.0 2020-06-07 [1]
rprojroot 1.3-2 2018-01-03 [1]
Rtsne 0.15 2018-11-10 [1]
S4Vectors 0.24.4 2020-04-09 [1]
scales 1.1.1 2020-05-11 [1]
seriation 1.2-8 2019-08-27 [1]
sessioninfo 1.1.1 2018-11-05 [1]
SEtools * 1.2.1 2020-06-03 [1]
shape 1.4.4 2018-02-07 [1]
stringi 1.4.6 2020-02-17 [1]
stringr 1.4.0 2019-02-10 [1]
SummarizedExperiment 1.16.1 2019-12-19 [1]
testthat 2.3.2 2020-03-02 [1]
tibble 3.0.1 2020-04-20 [1]
tidyselect 1.1.0 2020-05-11 [1]
TSP 1.1-10 2020-04-17 [1]
usethis 1.6.1 2020-04-29 [1]
V8 3.1.0 2020-05-29 [1]
vctrs 0.3.1 2020-06-05 [1]
viridis 0.5.1 2018-03-29 [1]
viridisLite 0.3.0 2018-02-01 [1]
withr 2.2.0 2020-04-20 [1]
writexl 1.2 2019-11-27 [1]
xfun 0.13 2020-04-13 [1]
XVector 0.26.0 2019-10-29 [1]
yaml 2.2.1 2020-02-01 [1]
zip 2.0.4 2019-09-01 [1]
zlibbioc 1.32.0 2019-10-29 [1]
source
CRAN (R 3.6.1)
CRAN (R 3.6.2)
Bioconductor
Bioconductor
Bioconductor
CRAN (R 3.6.1)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
CRAN (R 3.6.1)
CRAN (R 3.6.1)
CRAN (R 3.6.1)
CRAN (R 3.6.1)
Bioconductor
CRAN (R 3.6.1)
CRAN (R 3.6.2)
CRAN (R 3.6.1)
CRAN (R 3.6.1)
Bioconductor
CRAN (R 3.6.2)
CRAN (R 3.6.1)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
Bioconductor
CRAN (R 3.6.2)
CRAN (R 3.6.1)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
CRAN (R 3.6.1)
CRAN (R 3.6.1)
CRAN (R 3.6.1)
Bioconductor
Bioconductor
Bioconductor
CRAN (R 3.6.2)
CRAN (R 3.6.2)
CRAN (R 3.6.1)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
CRAN (R 3.6.1)
CRAN (R 3.6.1)
CRAN (R 3.6.2)
CRAN (R 3.6.1)
CRAN (R 3.6.1)
Bioconductor
CRAN (R 3.6.1)
CRAN (R 3.6.2)
CRAN (R 3.6.1)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
Bioconductor
CRAN (R 3.6.2)
CRAN (R 3.6.1)
CRAN (R 3.6.1)
CRAN (R 3.6.1)
CRAN (R 3.6.2)
Github (r-lib/memoise@4aefd9f)
CRAN (R 3.6.1)
CRAN (R 3.6.1)
CRAN (R 3.6.1)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
CRAN (R 3.6.1)
CRAN (R 3.6.2)
CRAN (R 3.6.1)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
CRAN (R 3.6.1)
CRAN (R 3.6.1)
CRAN (R 3.6.1)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
CRAN (R 3.6.1)
CRAN (R 3.6.2)
CRAN (R 3.6.1)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
Github (juba/rmdformats@94cd7a3)
CRAN (R 3.6.1)
CRAN (R 3.6.1)
Bioconductor
CRAN (R 3.6.2)
CRAN (R 3.6.1)
CRAN (R 3.6.1)
Bioconductor
CRAN (R 3.6.1)
CRAN (R 3.6.2)
CRAN (R 3.6.1)
Bioconductor
CRAN (R 3.6.2)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
CRAN (R 3.6.2)
CRAN (R 3.6.1)
CRAN (R 3.6.1)
CRAN (R 3.6.2)
CRAN (R 3.6.1)
CRAN (R 3.6.2)
Bioconductor
CRAN (R 3.6.2)
CRAN (R 3.6.1)
Bioconductor
[1] /home/ubuntu/R/x86_64-pc-linux-gnu-library/3.6
[2] /usr/local/lib/R/site-library
[3] /usr/lib/R/site-library
[4] /usr/lib/R/library